home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / FORTRAN / 3017.ZIP / RFAT.FOR < prev    next >
Text File  |  1988-11-03  |  2KB  |  112 lines
  1.       PROGRAM RFAT
  2. C
  3. C     TO READ FAT ON DISKETTES IN FLOPPY DRIVES
  4. C     OLYMPIC SOFTWARE  --  9/26/88
  5. C
  6.       EXTERNAL DBIOS,GETCAD
  7.       INTEGER*2 IAR(7),IES,IBX
  8.       INTEGER*2 IDATA(1024),IFCT(20)
  9.       INTEGER*2 I,I1,J,K,IH(6),IC1,IC2,ID,ID1,ID2
  10.       CHARACTER*1 ICDAT(1024),AB(2)
  11.       CHARACTER*2 AH(8),AC
  12.       EQUIVALENCE (AB(1),AC)
  13. C
  14. C***  GET ADDRESS OF ICDAT
  15.       CALL GETCAD(ICDAT,IES,IBX)
  16. C
  17. C**   RESET DISKETTE SYSTEM
  18.       IAR(1)=0
  19.       CALL DBIOS(IAR,IES,IBX)
  20. C
  21.       IAR(1)=2
  22.       IAR(2)=2
  23. C
  24.       WRITE(*,10)
  25.  10   FORMAT(' ENTER DOS SECTOR #(1 FOR 360K), DRIVE #(0 FOR "A"): ',$)
  26.       READ(*,*)I,IAR(6)
  27. C
  28. C**   BIOS SECTOR, SIDE, TRACK...
  29.       IAR(4)=1+I-INT(I/9.0)*9
  30.       IAR(5)=(I/9.0)-INT(I/18.0)*2
  31.       IAR(3)=I/(18.0)
  32. C
  33.       CALL DBIOS(IAR,IES,IBX)
  34. C
  35.       IF(IAR(7).EQ.1)THEN
  36.        WRITE(*,101)IAR(1)
  37.  101   FORMAT(' *** DISK ACCESS ERROR ! ',I5)
  38.        GOTO 700
  39.       ENDIF
  40. C
  41.       DO 29 I=1,1024
  42.       IDATA(I)=ICHAR(ICDAT(I))
  43.  29   CONTINUE
  44. C
  45.       DO 30 I=1,1024,8
  46.       I1=I-1
  47. C
  48. C**    CONVERT TO HEX IN ALPHANUMERIC TERMS
  49.        DO 31 K=1,8
  50.        ID=IDATA(I1+K)
  51.        ID1=ID/16.0
  52.        ID2=ID-ID1*16
  53.        IF(ID1.LT.10)THEN
  54.          AB(1)=CHAR(ID1+48)
  55.        ELSE
  56.          AB(1)=CHAR(ID1+55)
  57.        ENDIF
  58.        IF(ID2.LT.10)THEN
  59.          AB(2)=CHAR(ID2+48)
  60.        ELSE
  61.          AB(2)=CHAR(ID2+55)
  62.        ENDIF
  63.        AH(K)=AC
  64.  31    CONTINUE
  65. C
  66.       WRITE(*,20)I1,(IDATA(I1+J),J=1,8),(AH(J),J=1,8)
  67.  20   FORMAT(1X,I4,5X,8I4,10X,8(A2,1X))
  68.  30   CONTINUE
  69. C
  70. C**   DISCRAMBLE FOR FAT
  71.       K=0
  72.       J=-2
  73.       DO 40 I=1,534,3
  74.       J=J+2
  75.       I1=J+1
  76.       IH(1)=IDATA(I)/16.0
  77.       IH(2)=IDATA(I)-IH(1)*16
  78.       IH(3)=IDATA(I+1)/16.0
  79.       IH(4)=IDATA(I+1)-IH(3)*16
  80.       IH(5)=IDATA(I+2)/16.0
  81.       IH(6)=IDATA(I+2)-IH(5)*16
  82. C
  83.       IC1=IH(2)+IH(1)*16.0+IH(4)*256.0
  84.       IC2=IH(3)+IH(6)*16.0+IH(5)*256.0
  85.       WRITE(*,90)J,IC1,I1,IC2
  86.  90   FORMAT(3X,'CLUSTER NO. ',I4,'  CONTAINS ',I4,'  AND CLUSTER NO. ',
  87.      1 I4,'  CONTAINS ',I4)
  88. C
  89. C**   RECORD FAULTS
  90.       IF(IC1.EQ.4087)THEN
  91.         K=K+1
  92.         IFCT(K)=J
  93.       ENDIF
  94.       IF(IC2.EQ.4087)THEN
  95.         K=K+1
  96.         IFCT(K)=I1
  97.       ENDIF
  98. C
  99.  40   CONTINUE
  100. C
  101. C**   PRINT FAULTS
  102.       IF(K.NE.0)WRITE(*,62)
  103.  62   FORMAT(/,' BAD CLUSTERS...',/)
  104.       DO 60 I=1,K
  105.       WRITE(*,61)I,IFCT(I)
  106.  61   FORMAT(1X,2I5)
  107.  60   CONTINUE
  108. C
  109.  700  STOP
  110.       END
  111.  
  112.